home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / magic / d / mtutils.d < prev    next >
Text File  |  1997-10-26  |  12KB  |  294 lines
  1. (*----------------------------------------------------------------------*
  2.  *                                                                      *
  3.  *  MAGICTOOLS   Modula's  All purpose  GEM  Interface  Cadre  Toolbox  *
  4.  *               ÿ         ÿ            ÿ    ÿ          ÿ               *
  5.  *----------------------------------------------------------------------*
  6.  * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
  7.  *----------------------------------------------------------------------*
  8.  *            Dieses Modul ist urheberrechtlich geschtzt.              *
  9.  *                                                                      *
  10.  * Die Ver”ffentlichung des Quelltextes oder Teilen daraus, sowie die   *
  11.  * Verbreitung des bersetzten, nicht gelinkten Codes in schriftlicher, *
  12.  * oder maschinenlesbarer Form, insbesondere in Zeitschriften, Mail-    *
  13.  * boxen oder anderen Medien bedarf der ausdrcklichen schriftlichen    *
  14.  * Einverst„ndnisserkl„rung des Autors.                                 *
  15.  *                                                                      *
  16.  * Die Verbreitung des Moduls als Teil eines gelinkten Programms ist    *
  17.  * fr Lizenznehmer ausdrcklich erlaubt!  Der Autor beh„lt sich das    *
  18.  * Recht vor, diese Erlaubnis jederzeit und ohne Angaben von Grnden zu *
  19.  * widerrufen.                                                          *
  20.  *----------------------------------------------------------------------*)
  21.  
  22. (*----------------------------------------------------------------------*
  23.  * mtUtils      Dies und Das, fr jeden was...                          *
  24.  *----------------------------------------------------------------------*)
  25.  
  26. DEFINITION MODULE mtUtils;
  27.  
  28. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
  29.                         Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
  30.                         Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
  31.                         sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET;
  32.  
  33.  
  34.  
  35.  
  36.  
  37. IMPORT SYSTEM;
  38. FROM MagicAES IMPORT OBJECT;
  39.  
  40. TYPE    AnyType =       RECORD
  41.                          CASE x: sCARDINAL OF
  42.                           0:  int:  lINTEGER;|
  43.                           1:  card: lCARDINAL;|
  44.                           2:  hint: sINTEGER; lint: sINTEGER;|
  45.                           3:  hcard: sCARDINAL; lcard: sCARDINAL;|
  46.                           4:  b4: Byte; b3: Byte; b2: Byte; b1: Byte;|
  47.                          END;
  48.                         END;
  49. (* Der alte "CASE-Trick": Damit konnen sehr einfach bestimmte Teile
  50.  * eines Wertes isoliert werden.
  51.  *)
  52.  
  53. TYPE    tRect =         RECORD
  54.                          x: sINTEGER;
  55.                          y: sINTEGER;
  56.                          w: sINTEGER;
  57.                          h: sINTEGER;
  58.                         END;
  59. (* Rechteckfl„che. Wird z.b. bei allen Magic-Modulen benutzt, die mit
  60.  * den Dials oder den Popupmens zu tun haben.
  61.  *)
  62.  
  63. TYPE    tObjcTree =     POINTER TO ARRAY [0..MAX(sINTEGER)] OF OBJECT;
  64. (* Wird beim direkten manipulieren des Objektbaumes verwendet. 
  65.  * Beispiel:
  66.  * 
  67.  * VAR tree:= tObjcTree;
  68.  *
  69.  * IF SELECTED IN tree^[object].obState THEN ...
  70.  *)
  71.  
  72. (* Modifizieren der obState und obFlags *)
  73.  
  74. PROCEDURE InclFlag (tree: SYSTEM.ADDRESS; entry, bit: sINTEGER);
  75. (* Setzt bit in tree^[entry].obFlags *)
  76.  
  77. PROCEDURE ExclFlag (tree: SYSTEM.ADDRESS; entry, bit: sINTEGER);
  78. (* L”scht bit in tree^[entry].obFlags *)
  79.  
  80. PROCEDURE SetFlag (tree: SYSTEM.ADDRESS; entry, bit: sINTEGER; set: BOOLEAN);
  81. (* Setzt bzw. l”scht bit in tree^[entry].obFlags, in Abh„ngigkeit
  82.  * von set: Bei TRUE wird gesetzt, sonst gel”scht
  83.  *)
  84.  
  85. PROCEDURE InFlag (tree: SYSTEM.ADDRESS; entry, bit: sINTEGER): BOOLEAN;
  86. (* TRUE, wenn bit in tree^[entry].obFlags *)
  87.  
  88. PROCEDURE InclState (tree: SYSTEM.ADDRESS; entry, bit: sINTEGER);
  89. (* Setzt bit in tree^[entry].obState *)
  90.  
  91. PROCEDURE ExclState (tree: SYSTEM.ADDRESS; entry, bit: sINTEGER);
  92. (* L”scht bit in tree^[entry].obState *)
  93.  
  94. PROCEDURE InState (tree: SYSTEM.ADDRESS; entry, bit: sINTEGER): BOOLEAN;
  95. (* TRUE, wenn bit in tree^[entry].obState *)
  96.  
  97. PROCEDURE SetState (tree: SYSTEM.ADDRESS; entry, bit: sINTEGER; set: BOOLEAN);
  98. (* Setzt bzw. l”scht bit in tree^[entry].obState, in Abh„ngigkeit
  99.  * von set: Bei TRUE wird gesetzt, sonst gel”scht
  100.  *)
  101.  
  102. (* Hilfsfunktionen fr Three-State-Buttons *)
  103.  
  104. CONST    NOCHANGE = 0;       (* gepunktet  *)
  105.          CLEAR    = 1;       (* gel”scht   *)
  106.          SETNEW   = 2;       (* angekreuzt *)
  107.  
  108. PROCEDURE GetThreeState (tree: SYSTEM.ADDRESS; entry : sINTEGER): sINTEGER;
  109. (* Holt Status eines 3-State-Buttons *)
  110.  
  111. PROCEDURE SetThreeState (tree: SYSTEM.ADDRESS; entry, val : sINTEGER);
  112. (* Setzt Status eines 3-State-Buttons *)
  113.  
  114. (* Manipulieren von String-Objekten *)
  115.  
  116. PROCEDURE ObjcString (tree: SYSTEM.ADDRESS; entry: sINTEGER; VAR str: ARRAY OF CHAR);
  117. (* Liefert den String der folgenden Objekte: 
  118.  * GBOXCHAR, GTEXT, GBOXTEXT, GFTEXT, GFBOXTEXT, GBUTTON,
  119.  * GSTRING,  GTITLE
  120.  *)
  121.  
  122. PROCEDURE ObjcStringAdr (tree: SYSTEM.ADDRESS; entry: sINTEGER): SYSTEM.ADDRESS;
  123. (* Liefert einen Zeiger auf den String des Objekts *)
  124.  
  125. PROCEDURE SetObjcString (tree: SYSTEM.ADDRESS; entry: sINTEGER; REF  str: ARRAY OF CHAR);
  126. (* Setzt den String der folgenden Objekte indem str direkt in die Resource
  127.  * kopiert wird:  GBOXCHAR, GTEXT, GBOXTEXT, GFTEXT, GFBOXTEXT, GBUTTON,
  128.  * GSTRING,  GTITLE
  129.  *
  130.  * Ist der String krzer als die maximale L„nge wird mit Blanks bis zur
  131.  * maximalen L„nge aufgefllt. Dies gilt nicht fr TEDINFO-Objekte!
  132.  *)
  133.  
  134. PROCEDURE SetObjcStringAdr (tree: SYSTEM.ADDRESS; entry: sINTEGER; str: SYSTEM.ADDRESS);
  135. (* Setzt den String der folgenden Objekte durch Austausch des entspr.
  136.  * Zeigers:  GBOXCHAR, GTEXT, GBOXTEXT, GFTEXT, GFBOXTEXT, GBUTTON,
  137.  * GSTRING,  GTITLE
  138.  *)
  139.  
  140. PROCEDURE ObjcStrLen (tree: SYSTEM.ADDRESS; entry: sINTEGER;
  141.                       VAR textLen, tmpltLen: sINTEGER);
  142. (* Liefert die L„nge eine String-Objekts, bei TEDINFO-Objekten auch die
  143.  * L„nge des Templates; sonst ist tmpltLen -1.  Idee: Dirk Steins
  144.  *)
  145.  
  146.  
  147. (* Objektpositionen, Fl„chen, Rahmen etc. 
  148.  * 
  149.  * SEHR WICHTIG!!!
  150.  * ---------------
  151.  * ALLE Rechtecke sind jeweils Koordinate (x,y) sowie Breite und H”he!!!
  152.  *)
  153.  
  154. PROCEDURE ObjcPos (tree: SYSTEM.ADDRESS; entry: sINTEGER; VAR x, y: sINTEGER);
  155. (* berechnet die Position eines Objekts. Ist zwar das gleiche wie 
  156.  * ObjcOffset, aber wesentlich schneller, da es direkt im Objektbaum
  157.  * operiert, und nicht erst ber einen Trap2 gehen muž.
  158.  *)
  159.  
  160. PROCEDURE ObjcParent (objc: SYSTEM.ADDRESS; entry: sINTEGER): sINTEGER;
  161. (* Liefert das Parent-Objekt zu entry *)
  162.  
  163. PROCEDURE ObjcRect (tree: SYSTEM.ADDRESS; entry: sINTEGER; VAR rect: ARRAY OF LOC);
  164. (* Liefert Objektkoordinaten des Objektes relativ zum Parent-Objekt.
  165.  * Idee: Dirk Steins 
  166.  *)
  167.  
  168. PROCEDURE SetObjcRect (tree: SYSTEM.ADDRESS; entry: sINTEGER; rect: ARRAY OF LOC);
  169. (* Setzt Koordinaten (obX, obY, obWidth und obHeight des Objekts auf
  170.  * die in rect bergebenen Werte. (Relativ zum Parent-Objekt)
  171.  * Idee: Dirk Steins
  172.  *) 
  173.  
  174. PROCEDURE ObjcArea (tree: SYSTEM.ADDRESS; entry: sINTEGER; VAR rect: ARRAY OF LOC);
  175. (* Liefert Objektkoordinaten des Objekts relativ zum Bildschirm Ursprung *)
  176.  
  177. PROCEDURE ObjcFrame (tree: SYSTEM.ADDRESS; obj: sINTEGER): sINTEGER;
  178. (* Liefert die Rahmendicke eines Objekts. Dabei werden Stati wie OUTLINED und
  179.  * Shadowed bercksichtigt. Ist das Ergebnis kleiner als 0, liegt der Rahmen
  180.  * AUSSERHALB des Objekts, ansonsten INNERHALB!
  181.  *)
  182.  
  183. PROCEDURE CalcArea (tree: SYSTEM.ADDRESS; entry: sINTEGER; VAR rect: ARRAY OF LOC);
  184. (* Berechnet Umgebungsrechteck des Objektes. Die Objektstati werden 
  185.  * dabei bercksichtigt.
  186.  *)
  187.  
  188. CONST   SearchType =    0;
  189.         SearchState =   1;
  190.         SearchFlags =   2;
  191.  
  192. PROCEDURE ScanFlags (tree: SYSTEM.ADDRESS; set, entry, flag: sINTEGER): sINTEGER;
  193. (* Sucht einen bestimmtes Flag im Objektbaum, abh„ngig von set. 
  194.  * Wenn set = SearchType wird ein obType gesucht, bei set = SearchState wird 
  195.  * ein Flag im obState gesucht, bei set = SearchFlags in obFlags
  196.  *)
  197.  
  198. PROCEDURE ScanMenu (tree: SYSTEM.ADDRESS; scan: sINTEGER;
  199.                     kbshift: sBITSET; VAR title, item: INTEGER): BOOLEAN;
  200. (* Scannt einen Menbaum nach bestimmten Eintr„gen. So kann z.B. der User
  201.  * die Tastenbelegungen „ndern, ohne das das Programm ge„ndert werden muž...
  202.  * Die Tasteneintr„ge mssen allerdings in einer besonderen Form vorliegen!
  203.  * Es k”nnen normale Tasten, Tasten mit Control und Tasten mit Alternate
  204.  * vorkommen.  Ein normaler Tastencode muž - wie beim STE/TT-Desktop - in 
  205.  * eckige Klammern eingefažt sein. Fr Control wird das Zeichen ^ verwendet,
  206.  * fr Alternate das Zeichen, welches im Fuller-Feld eines Fensters steht.
  207.  * Beispiel:
  208.  *
  209.  *   Eintrag Normal    [M]
  210.  *   Eintrag Control   ^M
  211.  *   Eintrag Alternate #M
  212.  *
  213.  * Die Routine liefert TRUE, wenn ein Eintrag gefunden wurde.
  214.  *
  215.  * tree =       Adresse des Menbaums
  216.  * first =      Erster Eintrag ab dem gesucht werden soll
  217.  * last =       Letzter Eintrag in dem gesucht werden soll
  218.  * scan =       Scancode der gedrckten Taste
  219.  * kbshift =    Status der Sondertasten
  220.  * titel =      der gefundene Mentitel oder -1
  221.  * item =       der gefundene Meneintrag oder -1
  222.  *)
  223.  
  224.  
  225. (* Vermischtes *)
  226.  
  227. PROCEDURE CharCode (scan: sINTEGER; kbshift: sBITSET): CHAR;
  228. (* Liest die Tastaturtabelle aus und liefert anhand Scancode und Sonder-
  229.  * tastenstatus den ASCII-Code.
  230.  *)
  231.  
  232. PROCEDURE ScanCode (ch: CHAR): sINTEGER;
  233. (* Umkehrfunktion zu CharCode. Sucht anhand eines Chars nach dem Scancode,
  234.  * 0 wenn nicht gefunden. Achtung: Es existieren nicht zu allen Zeichen
  235.  * Scancodes, sondern nur fr jede Taste!!!
  236.  *)
  237.  
  238. PROCEDURE DoubleClick (VAR value: sINTEGER): BOOLEAN;
  239. (* Maskiert Bit15 aus value aus; liefert TRUE, wenn es gesetzt war.
  240.  * Sinn der šbung: DialDo bzw. FormDo liefern bei einem Doppelklick
  241.  * das angeklickte Objekt mit gesetzem Bit15.
  242.  *)
  243.  
  244. PROCEDURE Bounce;
  245. (* "Entprellt" die Maustaste. d.h. wartet, bis keine Maustaste mehr
  246.  * gedrckt wird.
  247.  *)
  248.  
  249. PROCEDURE Min (i1, i2: sINTEGER): sINTEGER;
  250. (* Liefert den kleineren der beiden Werte *)
  251.  
  252. PROCEDURE Max (i1, i2: sINTEGER): sINTEGER;
  253. (* Liefert den gr”žeren der beiden Werte *)
  254.  
  255.  
  256. (* Bei Magic sind alle Rechtecke blicherweise RELATIVE Koordinaten, will 
  257.  * sagen, sie bestehen aus Koordinate (x, y) sowie BREITE und H™HE. Dies
  258.  * entspricht den Rechtecken, wie sie das AES erwartet.
  259.  * Leider gilt dies nicht fr VDI-Rechtecke. Das VDI erwartet Rechtecke
  260.  * in ABSOLUTEN KOORDINATEN, also Koordinate "Links oben" und Koordinate
  261.  * (Rechts unten).
  262.  * 
  263.  * Die folgende Porzeduren dienen zum Manipulieren von Reckteck-
  264.  * KOORDINATEN.
  265.  *)
  266.  
  267. PROCEDURE AbsRect (VAR rect: ARRAY OF LOC);
  268.  (* Diese Prozedur wandelt ein relatives Rechteck in ein absolutes *)
  269.  
  270. PROCEDURE RelRect (VAR rect: ARRAY OF LOC);
  271.  (* Diese Prozedur wandelt ein absolutes Rechteck in ein relatives *)
  272.  
  273. PROCEDURE RectToVars (rect: ARRAY OF LOC;  abs: BOOLEAN;
  274.                       VAR x, y, w, h: sINTEGER);
  275. (* Macht aus einem Rechteck vier einzelne Variable.  Bei abs = TRUE werden
  276.  * absolute Werte geliefert (w:= x + w;).  Geht davon aus, daž die Daten
  277.  * in rect ein Rechteckt mit Koordinate und Breite/H”he darstellen -
  278.  * entsprechend dem Typ tRect;
  279.  *)
  280.  
  281. PROCEDURE VarsToRect (x, y, w, h: sINTEGER; abs: BOOLEAN;
  282.                       VAR rect: ARRAY OF LOC);
  283. (* Umkehrfunktion zu RectToVars *)
  284.  
  285. PROCEDURE AbsRectToVars (rect: ARRAY OF LOC;  abs: BOOLEAN;
  286.                          VAR x, y, w, h: sINTEGER);
  287. (* Wie RectToVars, geht aber von absoluten Koordinaten in rect aus *)
  288.  
  289. PROCEDURE AbsVarsToRect (x, y, w, h: sINTEGER; abs: BOOLEAN;
  290.                          VAR rect: ARRAY OF LOC);
  291. (* Umkehrfunktion zu AbsRectToVars *)
  292.  
  293. END mtUtils.
  294.